home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / apps / 25 / demos / 3dmole.bas next >
Encoding:
BASIC Source File  |  1986-06-19  |  6.8 KB  |  160 lines

  1. 0     '
  2. 10    title$=" 3D-Molecules "
  3. 20    title$=chr$(32)+chr$(14)+chr$(15)+title$
  4. 30    title$=title$+chr$(14)+chr$(15)+chr$(32)
  5. 40    poke systab+24,1
  6. 50    a#=gb
  7. 60    gintin=peek(a#+8)
  8. 70    poke gintin+0,peek(systab+8)
  9. 80    poke gintin+2,2
  10. 90    s#=gintin+4
  11. 100   title$=title$+chr$(0)
  12. 110   poke s#,varptr(title$)
  13. 120   gemsys(105)
  14. 130   poke systab+24,0:IF EX=1 THEN END
  15. 140   ' This program and the data files that come with it originally
  16. 150   ' were downloaded from BYTENET LISTINGS.   The program was 
  17. 160   ' originally designed for the IBM-PC.  I made the necessary 
  18. 170   ' modifications so as to take full advantage of the 520ST
  19. 180   ' the modifications involved removing almost HALF of the 
  20. 190   ' program because so much was already a part of ST BASIC
  21. 200   ' Run the program in LOW res only.  Look for a monochrome
  22. 210   ' version & other converted PC-programs soon.
  23. 220   ' The BYTE article covering this program is in the FEB-86 issue.
  24. 230   ' In there they say it takes a PC 20-40 seconds to do the plot.
  25. 240   ' It only takes the ST 4-15 seconds!!!!!!!!   Don't knock ST BASIC.
  26. 250   ' It is much more powerful than you think!
  27. 260   '
  28. 270   ' For the 'phi' and 'theta' values use 0,0 at first   
  29. 280   ' 'phi' rotates in horizontal plane
  30. 290   ' 'theta' rotates in vertical plane
  31. 300   '                  ********* COLOR3D.BAS *********
  32. 310   '  Draws a 3D, perspective image of a molecule on IBM PCs with BASICA.
  33. 320   '       *********   NOW for Atari 520/1040 ST   *********
  34. 330   '                For private, noncommercial use only.
  35. 340   '                 John J. Farrell *** April 1, 1985
  36. 350   ' Inspired by Earl Kirkland's MODEL3D.BAS for the Mac, BYTE, Feb. 1985.
  37. 360   '
  38. 370   ' ****** Atari 520/1040 ST Adaptation by Britton W. Robbins
  39. 380   ' ******                                 PO BOX 85152 MB 227
  40. 390   ' ******        February 2,1986          San Diego, CA 92138
  41. 400   COLOR 1,0,1,1,1
  42. 410   fullw 2:clearw 2:' clear screen for graphics
  43. 420   color 1,0,1,1,1
  44. 430   DEFINT I-N: DEFSNG O-Z: DEFSNG A-G
  45. 440   DIM X(200), Y(200), Z(200), S(200), COL(200),COLPAT(200)
  46. 450   '
  47. 460   ' Ask for input parameters.
  48. 470   GOTOXY 1,1:?"ENTER Q TO QUIT.":?:?:?
  49. 480   INPUT "Data file name:", FILE$:FILE$=FILE$+".DAT"
  50. 490   IF FILE$="Q.DAT" OR FILE$="q.DAT"THEN CLEARW 2:EX=1:title$="OUTPUT":goto 40
  51. 500   INPUT "Azim., polar angles (phi, theta):", PHI, THETA
  52. 510   INPUT "Viewing distance:",VIEWD
  53. 520   INPUT "Size magnitude:",SMAG
  54. 530   SMAG = 1.15*SMAG
  55. 540   ' DISTORT is used later to account for fact that one unit of x
  56. 550   ' on screen (horizonal) is not equal to one unit of z (vertical).
  57. 560   DISTORT = 1.2
  58. 570   ' Convert degrees to radians.
  59. 580   PHI = PHI*3.14159/180!: THETA = THETA*3.14159/180!
  60. 590   CP = COS(PHI): SP = SIN(PHI): CT = COS(THETA): ST = SIN(THETA)
  61. 600   '
  62. 610   OPEN "I",#1,FILE$
  63. 620   ' Set xmin very large and xmax very small.
  64. 630   XMIN = 1000000!: XMAX = -XMIN: YMIN = XMIN: YMAX = XMAX
  65. 640   ZMIN = XMIN: ZMAX = XMAX: N = 0
  66. 650   ' Read data file: color, x,y,z (atomic coords),r (Angstroms).
  67. 660   WHILE NOT EOF(1)
  68. 670   N = N + 1
  69. 680   INPUT #1,COLPAT(N), X(N),Y(N), Z(N), S(N)
  70. 690   ' Find maximum and minimum values for x,y,z.
  71. 700   IF X(N) > XMAX THEN XMAX = X(N)
  72. 710   IF X(N) < XMIN THEN XMIN = X(N)
  73. 720   IF Y(N) > YMAX THEN YMAX = Y(N)
  74. 730   IF Y(N) < YMIN THEN YMIN = Y(N)
  75. 740   IF Z(N) > ZMAX THEN ZMAX = Z(N)
  76. 750   IF Z(N) < ZMIN THEN ZMIN = Z(N)
  77. 760   WEND
  78. 770   PRINT N "atoms"
  79. 780   PRINT "rotating..."
  80. 790   ' Find center values for x,y,z.
  81. 800   XCEN = .5*(XMAX+XMIN): YCEN = .5*(YMIN + YMAX): ZCEN = .5*(ZMIN+ZMAX)
  82. 810   ' Rotate molecule around its center.
  83. 820   FOR I = 1 TO N
  84. 830   XA = X(I) - XCEN: YA = Y(I) - YCEN
  85. 840   X(I) = CP*XA+SP*YA: Y(I) = -SP*XA+CP*YA
  86. 850   YA = Y(I): ZA = Z(I) - ZCEN
  87. 860   Y(I) = CT*YA+ST*ZA: Z(I) = -ST*YA+CT*ZA
  88. 870   IF VIEWD < Y(I) THEN CLEARW 2:?"Viewing distance is within molecule!";
  89. 880   IF VIEWD < Y(I) THEN ?"   Rerun with a larger viewing distance.":goto 1270
  90. 890   NEXT I: PRINT "sorting..."
  91. 900   '
  92. 910   ' Sort by depth (shell sort).
  93. 920   IGAP = INT(CSNG(N)/2!)
  94. 930   WHILE IGAP >= 1
  95. 940   FOR I = IGAP +1 TO N
  96. 950   FOR J = I-IGAP TO 1 STEP -IGAP
  97. 960   JG = J + IGAP
  98. 970   IF Y(J) <= Y(JG) THEN GOTO 1020
  99. 980   SWAP X(J),X(JG): SWAP Y(J), Y(JG)
  100. 990   SWAP Z(J), Z(JG): SWAP S(J), S(JG)
  101. 1000  SWAP COL(J), COL(JG): SWAP COLPAT(J), COLPAT(JG)
  102. 1010  NEXT J
  103. 1020  NEXT I
  104. 1030  IGAP = INT(CSNG(IGAP)/2!)
  105. 1040  WEND
  106. 1050  '
  107. 1060  clearw 2
  108. 1070  ' Perspective projection and scale coordinates.
  109. 1080  SCALE = -1000000!: SMAX = SCALE
  110. 1090  FOR I = 1 TO N
  111. 1100  YA = 1!/(VIEWD - Y(I)): X(I) = X(I) *YA: Z(I) = Z(I) * YA: S(I) = S(I)*YA
  112. 1110  IF SCALE < ABS(X(I)) THEN SCALE = ABS(X(I))
  113. 1120  IF SCALE < ABS(Z(I)) THEN SCALE = ABS(Z(I))
  114. 1130  IF SMAX <S(I) THEN SMAX = S(I)
  115. 1140  NEXT I: SCALE = 75!/(SCALE + .5*SMAX*SMAG)
  116. 1150  SCALEX = SCALE*DISTORT
  117. 1160  '
  118. 1170  FOR I = 1 TO N
  119. 1180  ' Find screen x (ix) and screen z (iz) and screen radius (ir).
  120. 1190  ' Center of screen is x = 160 and z = 85.
  121. 1200  IX = INT(X(I)*SCALEX+ 160!): IZ = INT(Z(I)*SCALE + 85!)
  122. 1210  IR = INT(S(I)*SCALE*SMAG): IRZ = IR/DISTORT
  123. 1220  COL = COL(I): COLPAT = COLPAT(I)
  124. 1230  GOSUB 1300
  125. 1240  NEXT I
  126. 1250  CLOSE 1
  127. 1260  IF NOT INP(-2) THEN 1260
  128. 1270  CLEAR:GOTO 0
  129. 1280  ' Draw patterned circles at ix,iz with radius ir.
  130. 1290  ' Draw a blank circle in background color with negative outline
  131. 1300  color 1,1,1,2,8:PCIRCLE IX,IZ,IR+1
  132. 1310  FILCOL=COLPAT:FILX=IX:FILY=IZ:GOSUB 1330:'FILL IX,IZ-IRZ+1:FILL IX,IZ+IRZ-1
  133. 1320  RETURN
  134. 1330  ON FILCOL GOSUB 1350,1360,1370,1380,1390,1400,1410,1420,1430,1440,1450,1460,1470,1480,1490,1500,1510,1520,1530,1540,1550,1560,1570,1580
  135. 1340  RETURN
  136. 1350  COLOR 1,2,2,2,1:FILL FILX,FILY:RETURN
  137. 1360  COLOR 1,3,3,2,1:FILL FILX,FILY:RETURN
  138. 1370  COLOR 1,4,4,2,1:FILL FILX,FILY:RETURN
  139. 1380  COLOR 1,5,5,2,1:FILL FILX,FILY:RETURN
  140. 1390  COLOR 1,6,6,2,1:FILL FILX,FILY:RETURN
  141. 1400  COLOR 1,7,7,2,1:FILL FILX,FILY:RETURN
  142. 1410  COLOR 1,8,8,2,1:FILL FILX,FILY:RETURN
  143. 1420  COLOR 1,9,9,2,1:FILL FILX,FILY:RETURN
  144. 1430  COLOR 1,10,10,2,1:FILL FILX,FILY:RETURN
  145. 1440  COLOR 1,11,11,2,1:FILL FILX,FILY:RETURN
  146. 1450  COLOR 1,12,12,2,1:FILL FILX,FILY:RETURN
  147. 1460  COLOR 1,13,13,2,1:FILL FILX,FILY:RETURN
  148. 1470  COLOR 1,14,14,2,1:FILL FILX,FILY:RETURN
  149. 1480  COLOR 1,15,15,2,1:FILL FILX,FILY:RETURN
  150. 1490  COLOR 1,2,2,5,2:FILL FILX,FILY:RETURN
  151. 1500  COLOR 1,3,3,5,2:FILL FILX,FILY:RETURN
  152. 1510  COLOR 1,4,4,5,2:FILL FILX,FILY:RETURN
  153. 1520  COLOR 1,5,5,5,2:FILL FILX,FILY:RETURN
  154. 1530  COLOR 1,6,6,5,2:FILL FILX,FILY:RETURN
  155. 1540  COLOR 1,7,7,5,2:FILL FILX,FILY:RETURN
  156. 1550  COLOR 1,8,8,5,2:FILL FILX,FILY:RETURN
  157. 1560  COLOR 1,9,9,5,2:FILL FILX,FILY:RETURN
  158. 1570  COLOR 1,10,12,5,2:FILL FILX,FILY:RETURN
  159. 1580  COLOR 1,11,11,5,2:FILL FILX,FILY:RETURN
  160.